;;;;;;;;;;; Meta-evaluateur ;;;;;;;;;;;;;;
(load "compilateur-li")

;Meta-evalue une expression
(defun meval (expr)
  (create-compteur)
  (create-table)
  (print (lisp2li expr ()))
  (list(eval-li (lisp2li expr ()) ())))

					; Evalue des expressions du langage intermediaire
(defun eval-li (expr env)
  (if(atom (car expr))
					; Si le car est un entier (taille de l'environnement)
      (if (integerp (car expr))
	    (append(list(list 'LABEL (cadr expr)))(eval-li (cddr expr)(make-env-eval-li (car expr) () env))(list(list 'LOAD 'R8 'R0))(list(list 'RTN)))
					; Sinon on teste les cas
	(cond
	 ((eql :lit (car expr))(list(list 'MOVE (cdr expr) 'R8)))
	 ((eql :var (car expr))(list(list 'LOAD (list 'FP (cdr expr)) 'R8)))
	 ((eql :if (car expr))(progn
				(setf a (get-compteur))
				(setf b (get-compteur))
				(append (eval-li (cadr expr) env)
					(list(list 'COMP 'R0 1))
					(list(list 'JEQ a))
					(eval-li (cadddr expr) env)
					(list(list 'JUMP b))
					(list(list 'LABEL a))
					(eval-li (caddr expr) env)
					(list(list 'LABEL b)))))
				  
					;Fonction connue
	 ((eql :call (car expr))(append (push-arg (cddr expr) env)
					(charge-registre (cddr expr))
					(list(cons (cadr expr)(charge-call (cddr expr))))))

					;Fonction deja definie (on est dans le corps d'une fonction)
	 ((eql :mcall (car expr)) (append (list (list 'PUSH 'FP))
					  (list (list 'MOVE 'SP 'R1))
					  (push-arg (cddr expr) env)
					  (list (list 'MOVE 'R1 'FP))
					  (list (list 'JSR (cadr expr)))
					  (list (list 'ADD (* size -1) 'SP))
					  (list (list 'POP 'FP))))
       
					;Cas du unknown
	 ((eql :unknown (car expr))(let ((transf (lisp2li (second expr) (third expr))
						 (if (eq :unknown (car transf))
						     (error "unknown ~s" expr)
						   (progn (setf (car expr) (car transf))
							  (setf (cdr expr) (cdr transf))
							  (eval-li transf env)))))))
	 
					;Cas du progn
	 ((eql :progn (car expr))(map-eval-li (cdr expr) env))))
    (append (eval-li (car expr)env)(eval-li (cdr expr) env))))

(defun push-arg(expr env)
  (if(atom expr)
      ()
    (append (eval-li (car expr)env)(list(list 'PUSH 'R8))(push-arg (cdr expr)env))))

(defun charge-call(expr)
  (charge-call-n expr (- 9 (taille-liste expr))))

(defun charge-call-n(expr n)
  (if(<= n 8)
      (cons (aref tableau-registre n)(charge-call-n expr (+ n 1)))))

(defun charge-registre(expr)
  (charge-registre-n expr (- 8 (taille-liste expr))8))

(defun charge-registre-n(expr n x)
  (if(and (not(atom expr))(< n x))
      (cons (list 'POP (aref tableau-registre x))(charge-registre-n (cdr expr) n (- x 1)))))

(defun taille-liste(l)
  (if(atom l)
      0
    (+ 1 (taille-liste (cdr l)))))

(defun create-compteur()
  (setf compteur 0))

(defun get-compteur()
  (setf compteur (+ compteur 1))
  compteur)

(defun create-table()
  (setf tableau-registre (make-array 9))
  (setf (aref tableau-registre 0) 'R0)
  (setf (aref tableau-registre 1) 'R1)
  (setf (aref tableau-registre 2) 'R2)
  (setf (aref tableau-registre 3) 'R3)
  (setf (aref tableau-registre 4) 'R4)
  (setf (aref tableau-registre 5) 'R5)
  (setf (aref tableau-registre 6) 'R6)
  (setf (aref tableau-registre 7) 'R7)
  (setf (aref tableau-registre 8) 'R8))

(defun libere-tab(n)
  (setf(aref tableau-occupe n) F))


(defun registre-vide-n(n)
  (if(or(> n 8)(< n 0))
      NIL
    (if(eql F (aref tableau-occupe n))
	(aref tableau-occupe n)
      (registre-vide-n(+ 1 n)))))

;Decoupe les listes a evaluer
(defun map-eval-li (lexpr env)
  (if (null lexpr)
      ()
    (append (eval-li (car lexpr) env) (map-eval-li (cdr lexpr) env))))


;Construit l'environnement de l'evaluateur
(defun make-env-eval-li (taille args oenv)
    (setf size (- taille 1)))


(defun map-eval-li-array (args oenv pos nenv)
  (if (null args)
      nenv
    (progn (setf (aref nenv pos) (eval-li (car args) oenv))
	   (map-eval-li-array (cdr args) oenv (+ 1 pos) nenv))))

; ATTENTION : fonction de correction du bug introuvable sur le retour du map-eval-li
;             lors de la récupération des arguments dans le :call
(defun correctionBug (n)
  (if (atom n)
      ()
    ; Si le 1er est une liste
    (if (and (listp (car n)) (atom (car (car n))))
	(cons (car (car n)) (correctionBug (cdr n)))
      (cons (car n) (correctionBug (cdr n))))))

